{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Wire.MockInterpreters.UserStore where

import Cassandra.Util
import Data.Handle
import Data.Id
import Data.Time
import Data.Time.Calendar.OrdinalDate
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.State
import Wire.API.User hiding (DeleteUser)
import Wire.API.User qualified as User
import Wire.API.User.Search (SetSearchable (SetSearchable))
import Wire.StoredUser
import Wire.UserStore
import Wire.UserStore.IndexUser

inMemoryUserStoreInterpreter ::
  forall r.
  (Member (State [StoredUser]) r) =>
  InterpreterFor UserStore r
inMemoryUserStoreInterpreter = interpret $ \case
  CreateUser new _ -> modify (newStoredUserToStoredUser new :)
  GetUsers uids -> gets $ filter (\user -> user.id `elem` uids)
  UpdateUser uid update -> modify (map doUpdate)
    where
      doUpdate :: StoredUser -> StoredUser
      doUpdate u =
        if u.id == uid
          then
            maybe Imports.id setStoredUserAccentId update.accentId
              . maybe Imports.id setStoredUserAssets update.assets
              . maybe Imports.id setStoredUserPict update.pict
              . maybe Imports.id setStoredUserName update.name
              . maybe Imports.id setStoredUserLocale update.locale
              . maybe Imports.id setStoredUserSupportedProtocols update.supportedProtocols
              $ u
          else u
  UpdateEmailUnvalidated uid email -> modify (map doUpdate)
    where
      doUpdate :: StoredUser -> StoredUser
      doUpdate u =
        if u.id == uid
          then u {emailUnvalidated = Just email} :: StoredUser
          else u
  GetIndexUser uid ->
    gets $ fmap storedUserToIndexUser . find (\user -> user.id == uid)
  GetIndexUsersPaginated _pageSize _pagingState ->
    error "GetIndexUsersPaginated not implemented in inMemoryUserStoreInterpreter"
  UpdateUserHandleEither uid hUpdate -> runError $ modifyLocalUsers (traverse doUpdate)
    where
      doUpdate :: StoredUser -> Sem (Error StoredUserUpdateError : r) StoredUser
      doUpdate u
        | u.id == uid = do
            handles <- gets $ mapMaybe (.handle)
            when
              ( hUpdate.old
                  /= Just hUpdate.new
                  && elem hUpdate.new handles
              )
              $ throw StoredUserUpdateHandleExists
            pure $ setStoredUserHandle hUpdate.new u
      doUpdate u = pure u

      modifyLocalUsers :: forall r1. (Member (State [StoredUser]) r1) => ([StoredUser] -> Sem r1 [StoredUser]) -> Sem r1 ()
      modifyLocalUsers f = do
        us <- get
        us' <- f us
        put us'
  DeleteUser user -> modify $ filter (\u -> u.id /= User.userId user)
  LookupHandle h -> lookupHandleImpl h
  GlimpseHandle h -> lookupHandleImpl h
  LookupStatus uid -> lookupStatusImpl uid
  IsActivated uid -> isActivatedImpl uid
  LookupLocale uid -> lookupLocaleImpl uid
  UpdateUserTeam uid tid ->
    modify $
      map
        (\u -> if u.id == uid then u {teamId = Just tid} :: StoredUser else u)
  GetActivityTimestamps _ -> pure []
  GetRichInfo _ -> error "rich info not implemented"
  GetUserAuthenticationInfo _uid -> error "Not implemented"
  DeleteEmail uid -> modify (map doUpdate)
    where
      doUpdate :: StoredUser -> StoredUser
      doUpdate u = if u.id == uid then u {email = Nothing} else u
  GetUserTeam uid -> do
    gets $ \users -> do
      user <- find (\user -> user.id == uid) users
      user.teamId
  SetUserSearchable uid (SetSearchable searchable) -> modify $ map f
    where
      f u =
        if u.id == uid
          then u {Wire.StoredUser.searchable = Just searchable} :: StoredUser
          else u

storedUserToIndexUser :: StoredUser -> IndexUser
storedUserToIndexUser storedUser =
  -- If we really care about this, we could start storing the writetimes, but we
  -- don't need it right now
  let withDefaultTime x = WithWriteTime x $ Writetime $ UTCTime (YearDay 0 1) 0
   in IndexUser
        { userId = storedUser.id,
          teamId = withDefaultTime <$> storedUser.teamId,
          name = withDefaultTime storedUser.name,
          accountStatus = withDefaultTime <$> storedUser.status,
          handle = withDefaultTime <$> storedUser.handle,
          email = withDefaultTime <$> storedUser.email,
          colourId = withDefaultTime storedUser.accentId,
          activated = withDefaultTime storedUser.activated,
          serviceId = withDefaultTime <$> storedUser.serviceId,
          managedBy = withDefaultTime <$> storedUser.managedBy,
          ssoId = withDefaultTime <$> storedUser.ssoId,
          unverifiedEmail = Nothing,
          searchable = withDefaultTime <$> storedUser.searchable,
          writeTimeBumper = Nothing
        }

lookupLocaleImpl :: (Member (State [StoredUser]) r) => UserId -> Sem r (Maybe ((Maybe Language, Maybe Country)))
lookupLocaleImpl uid = do
  users <- get
  let mUser = find ((== uid) . (.id)) users
  pure $ (\u -> (u.language, u.country)) <$> mUser

isActivatedImpl :: (Member (State [StoredUser]) r) => UserId -> Sem r Bool
isActivatedImpl uid = do
  gets $
    maybe False (.activated)
      . find ((== uid) . (.id))

lookupStatusImpl :: (Member (State [StoredUser]) r) => UserId -> Sem r (Maybe AccountStatus)
lookupStatusImpl uid = do
  users <- get
  pure $ (.status) =<< (find ((== uid) . (.id)) users)

lookupHandleImpl ::
  (Member (State [StoredUser]) r) =>
  Handle ->
  Sem r (Maybe UserId)
lookupHandleImpl h = do
  gets $
    fmap (.id)
      . find ((== Just h) . (.handle))

newStoredUserToStoredUser :: NewStoredUser -> StoredUser
newStoredUserToStoredUser new =
  StoredUser
    { id = new.id,
      name = new.name,
      textStatus = new.textStatus,
      pict = Just new.pict,
      email = new.email,
      emailUnvalidated = new.email,
      ssoId = new.ssoId,
      accentId = new.accentId,
      assets = Just new.assets,
      activated = new.activated,
      status = Just new.status,
      expires = new.expires,
      language = Just new.language,
      country = new.country,
      providerId = new.providerId,
      serviceId = new.serviceId,
      handle = new.handle,
      teamId = new.teamId,
      managedBy = Just new.managedBy,
      supportedProtocols = Just new.supportedProtocols,
      searchable = Just new.searchable
    }
